home *** CD-ROM | disk | FTP | other *** search
/ AmigActive 2 / AACD 2.iso / AACD / Programming / fpc / compiler / pp.pas < prev    next >
Pascal/Delphi Source File  |  1998-09-24  |  15KB  |  535 lines
  1. {
  2.     $Id: pp.pas,v 1.1.1.1.2.2 1998/08/18 13:35:47 carl Exp $
  3.     Copyright (c) 1993-98 by Florian Klaempfl
  4.  
  5.     This program is free software; you can redistribute it and/or modify
  6.     it under the terms of the GNU General Public License as published by
  7.     the Free Software Foundation; either version 2 of the License, or
  8.     (at your option) any later version.
  9.  
  10.     This program is distributed in the hope that it will be useful,
  11.     but WITHOUT ANY WARRANTY; without even the implied warranty of
  12.     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  13.     GNU General Public License for more details.
  14.  
  15.     You should have received a copy of the GNU General Public License
  16.     along with this program; if not, write to the Free Software
  17.     Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  18.  
  19.  ****************************************************************************}
  20.  
  21. {
  22.   possible compiler switches (* marks a currently required switch):
  23.   -----------------------------------------------------------------
  24.   USE_RHIDE           generates errors and warning in an format recognized
  25.                       by rhide
  26.   TP                  to compile the compiler with Turbo or Borland Pascal
  27.   GDB*                support of the GNU Debugger
  28.   I386                generate a compiler for the Intel i386+
  29.   M68K                generate a compiler for the M68000
  30.   MULLER              release special debug code of Pierre Muller
  31.                       (needs some extra units)
  32.   USEOVERLAY          compiles a TP version which uses overlays
  33.   EXTDEBUG            some extra debug code is executed
  34.   SUPPORT_MMX         only i386: releases the compiler switch
  35.                       MMX which allows the compiler to generate
  36.                       MMX instructions
  37.   EXTERN_MSG          Don't compile the msgfiles in the compiler, always
  38.                       use external messagefiles
  39.   BIG_ENDIAN          Target machine where compiler will run is
  40.                       a BIG ENDIAN machine (such as m68k)
  41.   -----------------------------------------------------------------
  42.   -----------------------------------------------------------------
  43.  
  44.   Required switches for a i386 compiler be compiled by Free Pascal Compiler:
  45.   GDB;I386
  46.  
  47.   Required switches for a i386 compiler be compiled by Turbo Pascal:
  48.   GDB;I386;TP
  49.  
  50.   Required switches for a 68000 compiler be compiled by Turbo Pascal:
  51.   GDB;M68k;TP
  52. }
  53.  
  54. {$ifdef FPC}
  55.    {$ifndef GDB}
  56.       {$error The compiler switch GDB must be defined}
  57.    {$endif GDB}
  58.    {$ifndef I386}
  59.       {$ifndef M68K}
  60.         {$error One of the switches I386 or M68K must be defined}
  61.       {$endif M68K}
  62.    {$endif I386}
  63.    {$ifdef support_mmx}
  64.      {$ifndef i386}
  65.        {$error I386 switch must be on}
  66.      {$endif i386}
  67.    {$endif support_mmx}
  68. {$endif}
  69.  
  70. {$ifdef TP}
  71.   {$IFNDEF DPMI}
  72.     {$M 24576,0,655360}
  73.   {$ELSE}
  74.     {$M 49152}
  75.   {$ENDIF DPMI}
  76.   {$E+,N+,F+,S-,R-}
  77. {$endif TP}
  78.  
  79.  
  80. program pp;
  81.  
  82. {$IFDEF TP}
  83.   {$UNDEF PROFILE}
  84.   {$IFDEF DPMI}
  85.     {$UNDEF USEOVERLAY}
  86.   {$ENDIF}
  87. {$ENDIF}
  88. {$ifdef FPC}
  89.   {$UNDEF USEOVERLAY}
  90.   {$UNDEF USEPMD}
  91. {$ENDIF}
  92.  
  93. uses
  94. {$ifdef fpc}
  95.   {$ifdef GO32V2}
  96.     emu387,
  97.     dpmiexcp,
  98.   {$endif GO32V2}
  99. {$endif}
  100. {$ifdef useoverlay}
  101.   {$ifopt o+}
  102.     Overlay,ppovin,
  103.   {$else}
  104.   { warn when not $O+ is used }
  105.     - You must compile with the $O+ switch
  106.   {$endif}
  107. {$endif useoverlay}
  108. {$ifdef lock}
  109.   lock,
  110. {$endif lock}
  111. {$ifdef profile}
  112.   profile,
  113. {$endif profile}
  114. {$ifdef muller}
  115.   openfile,
  116.   {$ifdef usepmd}
  117.     usepmd,
  118.   {$endif usepmd}
  119. {$endif}
  120. {$ifdef LINUX}
  121.   catch,
  122. {$endif LINUX}
  123.   dos,objects,cobjects,
  124.   globals,parser,systems,tree,symtable,options,link,import,files,
  125.   verb_def,verbose;
  126.  
  127. {$ifdef useoverlay}
  128.   {$O files}
  129.   {$O globals}
  130.   {$O hcodegen}
  131.   {$O pass_1}
  132.   {$O tree}
  133.   {$O types}
  134.   {$O objects}
  135.   {$O options}
  136.   {$O cobjects}
  137.   {$O globals}
  138.   {$O systems}
  139.   {$O parser}
  140.   {$O dos}
  141.   {$O scanner}
  142.   {$O symtable}
  143.   {$O objects}
  144.   {$O aasm}
  145.   {$ifdef gdb}
  146.     {$O gdb}
  147.   {$endif gdb}
  148.   {$ifdef i386}
  149.     {$O opts386}
  150.     {$O cgi386}
  151.     {$O aopt386}
  152.     {$O cgai386}
  153.     {$O i386}
  154.     {$O radi386}
  155.     {$O rai386}
  156.     {$O ratti386}
  157.     {$O tgeni386}
  158.   {$endif}
  159.   {$ifdef m68k}
  160.     {$O opts68k}
  161.     {$O cg68k}
  162.     {$O ra68k}
  163.     {$O ag68kgas}
  164.   {$endif}
  165. {$endif useoverlay}
  166.  
  167.  
  168. function print_status(const status : tcompilestatus) : boolean;
  169. begin
  170.   print_status:=false;
  171.   if (abslines=1) then
  172.    Message1(general_i_kb_free,tostr(memavail shr 10));
  173.   if (status.currentline mod 100=0) then
  174.    Message2(general_l_lines_and_free,tostr(status.currentline),tostr(memavail shr 10));
  175. {$ifdef tp}
  176.   if (use_big) then
  177.    begin
  178.    {$ifdef dpmi}
  179.      Message1(general_i_stream_kb_free,tostr(symbolstream.getsize shr 10));
  180.    {$else}
  181.      Message1(general_i_ems_kb_free,tostr(symbolstream.getsize shr 10));
  182.    {$endif}
  183.    end;
  184. {$endif}
  185. end;
  186.  
  187.  
  188. function getrealtime : real;
  189. var
  190.   h,m,s,s100 : word;
  191. begin
  192.   dos.gettime(h,m,s,s100);
  193.   getrealtime:=h*3600.0+m*60.0+s+s100/100.0;
  194. end;
  195.  
  196.  
  197.  
  198. var
  199.   oldexit : pointer;
  200. procedure myexit;{$ifndef FPC}far;{$endif}
  201. begin
  202.   exitproc:=oldexit;
  203. {$ifdef tp}
  204.   if use_big then
  205.    symbolstream.done;
  206. {$endif}
  207.   if (erroraddr<>nil) then
  208.    begin
  209.      case exitcode of
  210.       202 : begin
  211.               erroraddr:=nil;
  212.               Writeln('Error: Stack Overflow');
  213.             end;
  214.       203 : begin
  215.               erroraddr:=nil;
  216.               Writeln('Error: Out of memory');
  217.             end;
  218.      end;
  219.    {when the module is assigned, then the messagefile is also loaded}
  220.      if assigned(current_module) and assigned(current_module^.current_inputfile) then
  221.       Writeln('Compilation aborted at line ',current_module^.current_inputfile^.line_no);
  222.    end;
  223.    { Close all remaining opened files }
  224.    CloseAll;
  225. end;
  226.  
  227.  
  228. {$ifdef tp}
  229.   procedure do_streamerror;
  230.   begin
  231.     if symbolstream.status=-2 then
  232.      WriteLn('Error: Not enough EMS memory')
  233.     else
  234.      WriteLn('Error: EMS Error ',symbolstream.status);
  235.   {$ifndef MULLER}
  236.     halt(1);
  237.   {$else MULLER}
  238.     runerror(190);
  239.   {$endif MULLER}
  240.   end;
  241.  
  242.   {$ifdef USEOVERLAY}
  243.     function _heaperror(size:word):integer;far;
  244.     type
  245.       heaprecord=record
  246.         next:pointer;
  247.         values:longint;
  248.       end;
  249.     var
  250.       l,m:longint;
  251.     begin
  252.       l:=ovrgetbuf-ovrminsize;
  253.       if (size>maxavail) and (l>=size) then
  254.        begin
  255.          m:=((longint(size)+$3fff) and $ffffc000);
  256.          {Clear the overlay buffer.}
  257.          ovrclearbuf;
  258.          {Shrink it.}
  259.          ovrheapend:=ovrheapend-m shr 4;
  260.          heaprecord(ptr(ovrheapend,0)^).next:=freelist;
  261.          heaprecord(ptr(ovrheapend,0)^).values:=m shl 12;
  262.          heaporg:=ptr(ovrheapend,0);
  263.          freelist:=heaporg;
  264.          Writeln('Warning: Overlay buffer shrinked, because of memory shortage');
  265.          _heaperror:=2;
  266.        end
  267.       else
  268.        _heaperror:=0;
  269.     end;
  270.   {$endif USEOVERLAY}
  271. {$endif TP}
  272.  
  273.  
  274.  
  275. var
  276.   start : real;
  277. {$IfDef Extdebug}
  278.   EntryMemAvail : longint;
  279. {$EndIf}
  280. begin
  281.   oldexit:=exitproc;
  282.   exitproc:=@myexit;
  283.  
  284.   start:=getrealtime;
  285. {$ifdef EXTDEBUG}
  286.    EntryMemAvail:=MemAvail;
  287. {$endif}
  288. {$ifdef MULLER}
  289.   {$ifdef DPMI}
  290.      HeapBlock:=$ff00;
  291.   {$endif DPMI}
  292. {$endif MULLER}
  293. {$ifdef TP}
  294.   {$IFDEF USEOVERLAY}
  295.     heaperror:=@_heaperror;
  296.   {$ENDIF USEOVERLAY}
  297.    if use_big then
  298.     begin
  299.       streamerror:=@do_streamerror;
  300.     { symbolstream.init('TMPFILE',stcreate,16000); }
  301.     {$ifndef dpmi}
  302.       symbolstream.init(10000,4000000); {using ems streams}
  303.     {$else}
  304.       symbolstream.init(1000000,16000); {using memory streams}
  305.     {$endif}
  306.       if symbolstream.errorinfo=stiniterror then
  307.        do_streamerror;
  308.     { write something, because pos 0 means nil pointer }
  309.       symbolstream.writestr(@inputfile);
  310.     end;
  311. {$endif tp}
  312.  
  313. {$ifndef TP}
  314.    compilestatusproc:=@print_status;
  315. {$else}
  316.    compilestatusproc:=print_status;
  317. {$endif}
  318.  
  319.    { inits which need to be done  before the arguments are parsed }
  320.    get_exepath;
  321.    init_tree;
  322.    globalsinit;
  323.    init_symtable;
  324.    linker.init;
  325.  
  326.    { read the arguments }
  327.    read_arguments;
  328.  
  329.    { inits which depend on arguments }
  330.    initparser;
  331.    initimport;
  332.  
  333.    {show some info}
  334.    Message1(general_i_compilername,FixFileName(paramstr(0)));
  335.    Message1(general_i_unitsearchpath,unitsearchpath);
  336.    Message1(general_d_sourceos,source_info.source_name);
  337.    Message1(general_i_targetos,target_info.target_name);
  338.    Message1(general_u_exepath,exepath);
  339. {$ifdef linux}
  340.    Message1(general_u_gcclibpath,Linker.gcclibrarypath);
  341. {$endif}
  342.  
  343.    compile(inputdir+inputfile+inputextension,false);
  344.  
  345.    if errorcount=0 then
  346.     begin
  347.       start:=getrealtime-start;
  348.       Message2(general_i_abslines_compiled,tostr(abslines),tostr(trunc(start))+'.'+tostr(trunc(frac(start)*10)));
  349.     end;
  350.  
  351.    clearnodes;
  352.    done_symtable;
  353. {$ifdef EXTDEBUG}
  354.    Comment(V_Info,'Memory lost = '+tostr(EntryMemAvail-MemAvail));
  355. {$endif EXTDEBUG}
  356. { exits with error 1 if no codegeneration }
  357.    if errorcount=0 then
  358.     halt(0)
  359.    else
  360.     halt(1);
  361. end.
  362. {
  363.   $Log: pp.pas,v $
  364.   Revision 1.1.1.1.2.2  1998/08/18 13:35:47  carl
  365.     + Implemented error recovery for files
  366.  
  367.   Revision 1.1.1.1.2.1  1998/08/13 13:21:48  carl
  368.     + added big_endian support
  369.  
  370.   Revision 1.1.1.1  1998/03/25 11:18:14  root
  371.   * Restored version
  372.  
  373.   Revision 1.40  1998/03/16 22:42:21  florian
  374.     * some fixes of Peter applied:
  375.       ofs problem, profiler support
  376.  
  377.   Revision 1.39  1998/03/10 15:20:30  carl
  378.     * bugfix of spelling mistake
  379.      * make it compile under TP with overlays
  380.  
  381.   Revision 1.38  1998/03/10 13:23:00  florian
  382.     * small win32 problems fixed
  383.  
  384.   Revision 1.37  1998/03/10 01:17:24  peter
  385.     * all files have the same header
  386.     * messages are fully implemented, EXTDEBUG uses Comment()
  387.     + AG... files for the Assembler generation
  388.  
  389.   Revision 1.36  1998/03/06 00:52:46  peter
  390.     * replaced all old messages from errore.msg, only ExtDebug and some
  391.       Comment() calls are left
  392.     * fixed options.pas
  393.  
  394.   Revision 1.35  1998/03/05 02:44:16  peter
  395.     * options cleanup and use of .msg file
  396.  
  397.   Revision 1.34  1998/03/04 17:33:52  michael
  398.   + Changed ifdef FPK to ifdef FPC
  399.  
  400.   Revision 1.33  1998/03/02 23:08:42  florian
  401.     * the concatcopy bug removed (solves problems when compilg sysatari!)
  402.  
  403.   Revision 1.32  1998/03/02 16:02:04  peter
  404.     * new style messages for pp.pas
  405.     * cleanup of pp.pas
  406.  
  407.   Revision 1.31  1998/03/02 13:38:49  peter
  408.     + importlib object
  409.     * doesn't crash on a systemunit anymore
  410.     * updated makefile and depend
  411.  
  412.   Revision 1.30  1998/03/02 01:49:05  peter
  413.     * renamed target_DOS to target_GO32V1
  414.     + new verbose system, merged old errors and verbose units into one new
  415.       verbose.pas, so errors.pas is obsolete
  416.  
  417.   Revision 1.29  1998/02/25 14:31:28  jonas
  418.     * added $d- for TP compiling (disable strict var checking) and removed a duplicate $M statement
  419.  
  420.   Revision 1.28  1998/02/22 23:03:29  peter
  421.     * renamed msource->mainsource and name->unitname
  422.     * optimized filename handling, filename is not seperate anymore with
  423.       path+name+ext, this saves stackspace and a lot of fsplit()'s
  424.     * recompiling of some units in libraries fixed
  425.     * shared libraries are working again
  426.     + $LINKLIB <lib> to support automatic linking to libraries
  427.     + libraries are saved/read from the ppufile, also allows more libraries
  428.       per ppufile
  429.  
  430.   Revision 1.27  1998/02/16 14:19:15  florian
  431.   *** empty log message ***
  432.  
  433.   Revision 1.26  1998/02/16 13:46:43  michael
  434.   + Further integration of linker object:
  435.     - all options pertaining to linking go directly to linker object
  436.     - removed redundant variables/procedures, especially in OS_TARG...
  437.  
  438.   Revision 1.25  1998/02/16 12:51:40  michael
  439.   + Implemented linker object
  440.  
  441.   Revision 1.24  1998/02/14 05:04:49  carl
  442.     + more overlay stuff for m68k target
  443.  
  444.   Revision 1.23  1998/02/14 01:45:30  peter
  445.     * more fixes
  446.     - pmode target is removed
  447.     - search_as_ld is removed, this is done in the link.pas/assemble.pas
  448.     + findexe() to search for an executable (linker,assembler,binder)
  449.  
  450.   Revision 1.22  1998/02/13 22:26:39  peter
  451.     * fixed a few SigSegv's
  452.     * INIT$$ was not written for linux!
  453.     * assembling and linking works again for linux and dos
  454.     + assembler object, only attasmi3 supported yet
  455.     * restore pp.pas with AddPath etc.
  456.  
  457.   Revision 1.18  1998/02/03 22:13:34  florian
  458.     * clean up
  459.  
  460.   Revision 1.17  1998/02/02 00:55:33  peter
  461.     * defdatei -> deffile and some german comments to english
  462.     * search() accepts : as seperater under linux
  463.     * search for ppc.cfg doesn't open a file (and let it open)
  464.     * reorganize the reading of parameters/file a bit
  465.     * all the PPC_ environments are now for all platforms
  466.  
  467.   Revision 1.16  1998/01/27 10:48:19  florian
  468.     * dpmiexcp is now always used by a go32v2 compiler executable
  469.  
  470.   Revision 1.15  1998/01/25 18:45:50  peter
  471.     + Search for as and ld at startup
  472.     + source_info works the same as target_info
  473.     + externlink allows only external linking
  474.  
  475.   Revision 1.14  1998/01/23 10:46:42  florian
  476.     * small problems with FCL object model fixed, objpas?.inc is compilable
  477.  
  478.   Revision 1.13  1998/01/18 21:34:29  florian
  479.   *** empty log message ***
  480.  
  481.   Revision 1.12  1998/01/16 12:52:10  michael
  482.   + Path treatment and file searching should now be more or less in their
  483.     definite form:
  484.     - Using now modified AddPathToList everywhere.
  485.     - File Searching mechanism is uniform for all files.
  486.     - Include path is working now !!
  487.     All fixes by Peter Vreman. Tested with remake3 target.
  488.  
  489.   Revision 1.11  1998/01/07 00:17:04  michael
  490.   Restored released version (plus fixes) as current
  491.  
  492.   Revision 1.10  1997/12/12 13:28:39  florian
  493.   + version 0.99.0
  494.   * all WASM options changed into MASM
  495.   + -O2 for Pentium II optimizations
  496.  
  497.   Revision 1.9  1997/12/09 13:57:21  carl
  498.   * bugfix when compiling using overlays
  499.  
  500.   Revision 1.8  1997/12/05 14:38:39  carl
  501.   * equivalent to version 1.5 (otherwise would not compile)
  502.  
  503.   Revision 1.5  1997/12/03 14:36:14  carl
  504.   * bugfix of my bug with $ifdef support_mxx
  505.  
  506.   Revision 1.4  1997/12/03 13:41:37  carl
  507.    + checks that i386 is defined if with mmx_support switch.
  508.  
  509.   Revision 1.3  1997/11/29 15:40:10  florian
  510.   + myexit is now executed
  511.  
  512.   Revision 1.2  1997/11/28 18:14:43  pierre
  513.    working version with several bug fixes
  514.  
  515.   Revision 1.1.1.1  1997/11/27 08:33:00  michael
  516.   FPC Compiler CVS start
  517.  
  518.  
  519.   Pre-CVS log:
  520.  
  521.   FK     Florian Klaempfl
  522.   +      feature added
  523.   -      removed
  524.   *      bug fixed or changed
  525.  
  526.   History (started at 19th september 1997):
  527.       19th september 1997:
  528.        + informations about ccompiler switches added (FK)
  529.        2nd october 1997:
  530.          *- removed ifndef dpmi for stream init, tmemorystream is used if
  531.           in dpmi everywhere else if use_big on. (CEC)
  532.        6th november 1997:
  533.          - crt unit to allow output redirection (FK)
  534. }
  535.